home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0066_VGA Text Mode Demo.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-02  |  10KB  |  474 lines
  1. {
  2. KAI ROHRBACHER
  3.  
  4. >> VGA Text mode (which is just an all-points-not-addressable mode,
  5. >> whereas the Graphics modes we're all familiar With are called all-
  6. >> points-addressable. The point is that whether all the points are
  7. >> addressable or not is irrevelant, but rather the "points" are
  8. >> there period.)
  9.  
  10. No.  The  width  of  a  normal  256  color  Graphics mode counts twice
  11. compared  to the pixel frequency of a 16 color mode (Text or Graphic):
  12. a  320  pixel  resolution in 256 colors needs the same clock rate as a
  13. 640 pixel resolution in 16 color mode.
  14.  
  15. >> Anyway, the VGA Text mode consists of 80 Characters wide
  16. >> each which are 9 points wide. Do you see where I'm going...the VGA
  17. >> ISSSSS capable of 720 pixels wide.
  18. > I wouldn't doubt it since we've seen 640x480x16 on a regular VGA.
  19. > 720 isn't far from 640.
  20.  
  21. That's  why  it  is  so  easy  to  trick  the  VGA into 360x400x256 or
  22. 360x480x256 modes: 80 Text columns * 9 pixels = 720 pixels. 720/2=360.
  23. Here's  a  small Program, demonstrating some Graphics mode; it's taken
  24. from a German computer magazine, I just ported it from "C" to TP.
  25. Note  that  For  the  same reason, I doubt that the claimed resolution
  26. 640x400x256  will  run  on  a  standard  VGA:  it  would require a dot
  27. frequency of 1280 pixels in a 16 color mode!
  28. }
  29.  
  30. Program vgademo;
  31.  
  32. Uses
  33.   Dos, Crt;
  34.  
  35. Const
  36.   maxPar = 23;
  37.  
  38. Type
  39.   parameter = Array [0..maxPar] of Byte;
  40.  
  41. Const
  42.  CrtRegVal320x240 : parameter { Static }  =
  43.    (95,79,80,130,84,128,13,62,0,65,0,0,0,0,0,0,234,172,223,40,0,231,6,227);
  44.  CrtRegVal320x400 : parameter { Static }  =
  45.    (95,79,80,130,84,128,191,31,0,64,0,0,0,0,0,0,156,142,143,40,0,150,185,227);
  46.  CrtRegVal360x480 : parameter { Static }  =
  47.    (107,89,90,142,94,138,13,62,0,64,0,0,0,0,0,0,234,172,223,45,0,231,6,227);
  48.  CrtRegVal640x400 : parameter { Static }  =
  49.    (95,79,80,130,84,128,191,31,0,64,0,0,0,0,0,0,156,142,143,40,0,150,185,163);
  50.  
  51.  actualMode :Byte = 0;
  52.  
  53.  R640x400 = 4;
  54.  R360x480 = 3;
  55.  R320x400 = 2;
  56.  R320x240 = 1;    { die moeglichen Aufloesungen }
  57.  
  58.  
  59. Var
  60.   ch       : Char;
  61.   VideoRam,
  62.   zb4,           {ein 1/4 der Bytes je Grafikzeile}
  63.   max_X,
  64.   max_Y    : Word;
  65.   regs     : Registers;
  66.  
  67. Function ReadMode : Byte;
  68. begin
  69.   regs.ah := $f;
  70.   intr($10, regs);
  71.   ReadMode := regs.al;
  72. end;
  73.  
  74.  
  75. Procedure OldMode(OldMod : Byte);
  76. begin
  77.   regs.ah := 0;
  78.   regs.al := OldMod;
  79.   intr($10, regs);
  80. end;
  81.  
  82.  
  83. Procedure Mode(Resolution : Word);
  84. Var
  85.   Read_1,
  86.   RegNumber : Word;
  87. begin
  88.  regs.ax := $0012;
  89.  intr($10, regs);
  90.  regs.ax := $0013;
  91.  intr($10, regs);
  92.  portw[$3c4] := $0604;
  93.  port[$3d4]  := $11;
  94.  Read_1      := port[$03d5] And $7f;
  95.  port[$03d5] := Read_1;
  96.  
  97.  Case Resolution Of
  98.    R320x240 :
  99.    begin
  100.      actualMode   := R320x240;
  101.      portw[$03c4] := $0100;
  102.      port[$03c2]  := $e3;
  103.      portw[$03c4] := $0300;
  104.      For RegNumber := 0 to maxPar DO
  105.        portw[$03d4] := CrtRegVal320x240[RegNumber] SHL 8 + RegNumber;
  106.      zb4   := 80;
  107.      max_X := 319;
  108.      max_Y := 239;
  109.    end;
  110.  
  111.    R320x400 :
  112.    begin
  113.      actualMode := R320x400;
  114.      For RegNumber := 0 to maxPar DO
  115.        portw[$03d4] := CrtRegVal320x400[RegNumber] SHL 8 + RegNumber;
  116.      zb4   := 80;
  117.      max_X := 319;
  118.      max_Y := 399;
  119.    end;
  120.  
  121.    R360x480 :
  122.    begin
  123.      actualMode := R360x480;
  124.      portw[$03c4] := $0100;
  125.      port[$03c2]  := $e7;
  126.      portw[$03c4] := $0300;
  127.      For RegNumber := 0 to maxPar DO
  128.        portw[$03d4] := CrtRegVal360x480[RegNumber] SHL 8 + RegNumber;
  129.      zb4   := 90;
  130.      max_X := 359;
  131.      max_Y := 479;
  132.    end;
  133.  
  134.    R640x400 :
  135.    begin
  136.      actualMode   := R640x400;
  137.      {hier!}
  138.      portw[$03c4] := $0100;
  139.      port[$03c2]  := $e7;
  140.      portw[$03c4] := $0300;
  141.      For RegNumber := 0 to maxPar DO
  142.        portw[$03d4] := CrtRegVal640x400[RegNumber] SHL 8 + RegNumber;
  143.      zb4   := 160;
  144.      max_X := 639;
  145.      max_Y := 399;
  146.    end
  147.  end;
  148.  
  149.  VideoRam := $a000;
  150. end;
  151.  
  152.  
  153. Procedure Paint(Resolution, Side : Word);
  154. begin
  155.   Case Resolution Of
  156.     R320x240 : Case Side Of
  157.                  1  : VideoRam := $a000;
  158.                  2  : VideoRam := $a4b0;
  159.                  3  : VideoRam := $a960;
  160.                  else VideoRam := $a000;
  161.                end;
  162.     R320x400 : Case Side Of
  163.                  1  : VideoRam := $a000;
  164.                  2  : VideoRam := $a800;
  165.                  else VideoRam := $a000;
  166.                end;
  167.     R360x480,
  168.     R640x400 : VideoRam := $a000;
  169.     else
  170.       VideoRam := $a000;
  171.   end;
  172. end;
  173.  
  174.  
  175. Procedure Show(Resolution, Side : Word);
  176. Var
  177.   Start : Word;
  178. begin
  179.   Case Resolution Of
  180.     R320x240 :
  181.     Case Side Of
  182.       1 : Start := 0;
  183.       2 : Start := $4b;
  184.       3 : Start := $96;
  185.       else { Default } Start := 0;
  186.     end;
  187.  
  188.     R320x400:
  189.     Case Side Of
  190.       1 : Start := 0;
  191.       2 : Start := $80;
  192.       else { Default } Start := 0;
  193.     end;
  194.  
  195.     R360x480,
  196.     R640x400 : Start := 0;
  197.  
  198.     else { Default } Start := 0;
  199.   end;
  200.   portw[$03d4] := Start SHL 8 + $0c;
  201. end;
  202.  
  203.  
  204. Procedure SetPoint(x, y, Color : Word);
  205. Var
  206.   Offset : Word;
  207. begin
  208. { if actualMode=R640x400
  209.   then Offset:=(y*zb4)+ (x shr 1 and $FE)
  210.   else}
  211.   Offset := (y * zb4) + (x Shr 2);
  212.   portw[$03c4] := (1 Shl ((x And 3) + 8)) + 2;
  213.   mem[VideoRam : Offset] := Color;
  214. end;
  215.  
  216.  
  217. Function GetPoint(x, y : Word) : Word;
  218. Var
  219.   Offset : Word;
  220. begin
  221. { if actualMode=R640x400
  222.   then Offset:=(y*zb4)+ (x shr 1 and $FE)
  223.   else}
  224.   Offset := (y * zb4) + (x Shr 2);
  225.   portw[$03ce] := (x And 3) SHL 8 + 4;
  226.   GetPoint := mem[VideoRam : Offset];
  227. end;
  228.  
  229. { Demo-HauptProgramm }
  230.  
  231. Procedure main;
  232. Var
  233.   x,
  234.   y,
  235.   c,
  236.   OldMod : Word;
  237.  
  238. begin
  239.   OldMod := ReadMode; { speichert alten Videomodus in Oldmod }
  240.   Writeln('VGASTAR');
  241.   Writeln('320x240 (3 Seiten), 320x400 (2 Seiten ) 360x480 oder');
  242.   Writeln('640x400 Pixel in 256 Farben auf Standard-VGA mit 256K');
  243.   Writeln('1991 Ingo Spitczok von Brisinski, c''t 12/91');
  244.   Writeln(' Modus 1: 320 x 240 Pixel mit 3 Seiten');
  245.   Write('Bitte Return-Taste druecken');
  246.   ch := ReadKey;
  247.   Mode(R320x240);
  248.   Show(R320x240, 1);
  249.   Paint(R320x240, 1);
  250.   x := 0;
  251.   While (x <= max_X) Do
  252.   begin
  253.     y := 0;
  254.     While (y <= max_Y) Do
  255.     begin
  256.       { male in 256 Farben }
  257.       SetPoint(x, y, ((x + y) And 255));
  258.       y := Succ(y)
  259.     end;
  260.     x := Succ(x)
  261.   end;
  262.  
  263.   Show(R320x240, 2);
  264.   Paint(R320x240, 2);
  265.   x := 100;
  266.   While (x < 201) Do
  267.   begin
  268.     y := 100;
  269.     While (y < 201) Do
  270.     begin
  271.       { Quadrat 100x100 Pixel }
  272.       SetPoint(x, y, ((x + y) And 255));
  273.       y := Succ(y)
  274.     end;
  275.     x := Succ(x)
  276.   end;
  277.  
  278.   Paint(R320x240, 3);
  279.   c := 0;
  280.   While (c <= max_Y) Do
  281.   begin
  282.     SetPoint(c, c, 10);
  283.     c := Succ(c)
  284.   end;
  285.  
  286.   ch := ReadKey;
  287.   Show(R320x240, 3);
  288.   ch := ReadKey;
  289.   Show(R320x240, 1);
  290.   ch := ReadKey;
  291.   OldMode(OldMod);
  292.   Writeln(' Modus 2: 320 x 400 Pixel, 2 Seiten');
  293.   ch := ReadKey;
  294.   Mode(R320x400);
  295.   Show(R320x400, 1);
  296.   Paint(R320x400, 1);
  297.   x := 0;
  298.  
  299.   While (x <= max_X) Do
  300.   begin
  301.     y := 0;
  302.     While (y < 200) Do
  303.     begin
  304.       SetPoint(x, y, ((x + y) And 255));
  305.       y := Succ(y)
  306.     end;
  307.     x := Succ(x)
  308.   end;
  309.  
  310.   x := 0;
  311.   While (x < 320) Do
  312.   begin
  313.     y := 200;
  314.     While (y < 400) Do
  315.     begin
  316.       SetPoint(x, y, 22);
  317.       y := Succ(y)
  318.     end;
  319.     x := Succ(x)
  320.   end;
  321.  
  322.   Paint(R320x400, 2);
  323.   x := 80;
  324.   While (x < 220) Do
  325.   begin
  326.     y := 0;
  327.     While (y <= max_Y) Do
  328.     begin
  329.       SetPoint(x, y, ((x + y) And 255));
  330.       y := Succ(y)
  331.     end;
  332.     x := Succ(x)
  333.   end;
  334.  
  335.   ch := ReadKey;
  336.   Show(R320x400, 2);
  337.   ch := ReadKey;
  338.   Show(R320x400, 3);
  339.   Paint(R320x400, 1);
  340.   x := 100;
  341.  
  342.   While (x < 200) Do
  343.   begin
  344.     y := 0;
  345.     While (y < 50) Do
  346.     begin
  347.       c := GetPoint(x, y);
  348.       { Lies die Farbe }
  349.       SetPoint(x, y + 250, c);
  350.       { Male die gelesene Farbe } ;
  351.       y := Succ(y)
  352.     end;
  353.     x := Succ(x)
  354.   end { For };
  355.  
  356.   ch := ReadKey;
  357.   OldMode(OldMod);
  358.   Writeln(' Modus 3: 360 x 400 Pixel, 1 Seite');
  359.   ch := ReadKey;
  360.   Mode(R360x480);
  361.   x := 0;
  362.  
  363.   While (x < 320) Do
  364.   begin
  365.     y := 0;
  366.     While (y < 200) Do
  367.     begin
  368.       SetPoint(x, y, (x And 255));
  369.       y := Succ(y)
  370.     end;
  371.     x := Succ(x)
  372.   end;
  373.  
  374.   x := 0;
  375.   While (x <= max_X) Do
  376.   begin
  377.     y := 200;
  378.     While (y <= max_Y) Do
  379.     begin
  380.       SetPoint(x, y, y And 255);
  381.       y := Succ(y)
  382.     end;
  383.     x := Succ(x)
  384.   end;
  385.  
  386.   x := 320;
  387.   While (x <= max_X) Do
  388.   begin
  389.     y := 0;
  390.     While (y  <=  max_Y) Do
  391.     begin
  392.       SetPoint(x, y, 25);
  393.       y  :=  Succ(y)
  394.     end;
  395.     x  :=  Succ(x)
  396.   end;
  397.  
  398.   x  :=  0;
  399.   While (x <= max_X) Do
  400.   begin
  401.     y := 400;
  402.     While (y <= max_Y) Do
  403.     begin
  404.       SetPoint(x, y, 26);
  405.       y := Succ(y)
  406.     end;
  407.     x := Succ(x)
  408.   end;
  409.  
  410.   ch := ReadKey;
  411.   OldMode(OldMod);
  412.   Writeln(' Modus 4: 640 x 400 Pixel, 1 Seite');
  413.   ch := ReadKey;
  414.   Mode(R640x400);
  415.   x := 0;
  416.  
  417.   While (x <= max_X) Do
  418.   begin
  419.     y := 0;
  420.     While (y <= max_Y) Do
  421.     begin
  422.       { male in 256 Farben };
  423.       SetPoint(x, y, ((x+y) And 255));
  424.       y := Succ(y)
  425.     end;
  426.     x := Succ(x)
  427.   end;
  428.  
  429.   x := 0;
  430.   While (x < 400) Do
  431.   begin
  432.     y := x;
  433.     While (y < 400) Do
  434.     begin
  435.       c := GetPoint(x, y);
  436.       SetPoint(x, y, 255-c);
  437.       { aendere Farbe};
  438.       y := Succ(y)
  439.     end;
  440.     x := Succ(x)
  441.   end;
  442.   ch := ReadKey;
  443.   OldMode(OldMod);
  444. end;
  445.  
  446. Procedure SetPix(x, y, Color : Word);
  447. Var
  448.   Offset : Word;
  449. begin
  450.   if actualMode = R640x400 then
  451.     Offset := (y * zb4) + (x shr 1 and $FE)
  452.   else
  453.     Offset := (y * zb4) + (x Shr 2);
  454.   portw[$03c4] := (1 Shl ((x And 3) + 8)) + 2;
  455.   mem[VideoRam : Offset] := Color;
  456. end;
  457.  
  458.  
  459. Function GetPix(x, y : Word) : Word;
  460. Var
  461.   Offset : Word;
  462. begin
  463. { if actualMode=R640x400
  464.   then Offset := (y*zb4)+ (x shr 1 and $FE)
  465.   else}
  466.   Offset := (y * zb4) + (x Shr 2);
  467.   portw[$03ce] := (x And 3) SHL 8 + 4;
  468.   GetPix := mem[VideoRam : Offset];
  469. end;
  470.  
  471. begin
  472.   main;
  473. end.
  474.